home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / misc / dspice0s / shlsrt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-22  |  1.8 KB  |  95 lines
  1. /* shlsrt.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /*<       subroutine shlsrt(a,n) >*/
  9. /* Subroutine */ int shlsrt_(a, n)
  10. doublereal *a;
  11. integer *n;
  12. {
  13.     static integer h, i, j;
  14.     static doublereal ak, ar;
  15.  
  16.     /* Parameter adjustments */
  17.     --a;
  18.  
  19.     /* Function Body */
  20. /*<       implicit double precision (a-h,o-z) >*/
  21.  
  22. /*     this routine sorts the array a using a shell sort algorithm. */
  23.  
  24. /*<       dimension a(n) >*/
  25. /*<       integer h >*/
  26.  
  27.  
  28. /* ...  compute best starting step size */
  29. /*<       h=1 >*/
  30.     h = 1;
  31. /*<    10 h=3*h+1 >*/
  32. L10:
  33.     h = h * 3 + 1;
  34. /*<       if (h.lt.n) go to 10 >*/
  35.     if (h < *n) {
  36.     goto L10;
  37.     }
  38. /* ...  back off two times */
  39. /*<       h=(h-1)/3 >*/
  40.     h = (h - 1) / 3;
  41. /*<       h=(h-1)/3 >*/
  42.     h = (h - 1) / 3;
  43. /*<       h=max0(h,1) >*/
  44.     h = max(h,1);
  45.  
  46. /*  shell sort */
  47.  
  48. /*<    20 j=h+1 >*/
  49. L20:
  50.     j = h + 1;
  51. /*<       go to 60 >*/
  52.     goto L60;
  53. /*<    30 i=j-h >*/
  54. L30:
  55.     i = j - h;
  56. /* ...  ak = record key;  ar = record */
  57. /*<       ak=a(j) >*/
  58.     ak = a[j];
  59. /*<       ar=ak >*/
  60.     ar = ak;
  61. /*<    40 if (ak.ge.a(i)) go to 50 >*/
  62. L40:
  63.     if (ak >= a[i]) {
  64.     goto L50;
  65.     }
  66. /*<       a(i+h)=a(i) >*/
  67.     a[i + h] = a[i];
  68. /*<       i=i-h >*/
  69.     i -= h;
  70. /*<       if (i.ge.1) go to 40 >*/
  71.     if (i >= 1) {
  72.     goto L40;
  73.     }
  74. /*<    50 a(i+h)=ar >*/
  75. L50:
  76.     a[i + h] = ar;
  77. /*<       j=j+1 >*/
  78.     ++j;
  79. /*<    60 if (j.le.n) go to 30 >*/
  80. L60:
  81.     if (j <= *n) {
  82.     goto L30;
  83.     }
  84. /*<       h=(h-1)/3 >*/
  85.     h = (h - 1) / 3;
  86. /*<       if (h.ne.0) go to 20 >*/
  87.     if (h != 0) {
  88.     goto L20;
  89.     }
  90. /*<       return >*/
  91.     return 0;
  92. /*<       end >*/
  93. } /* shlsrt_ */
  94.  
  95.